 Loading |
|
Loading |
| VBScript |
| JavaScript |
| Powershell |
Search Options: 2008 Scripting Games Advanced VBScript Event 2
|
||
|
' This is my Solution for the Scripting Games 2008
' For more Information look at ' http://www.microsoft.com/technet/scriptcenter/funzone/games/games08.mspx Option Explicit Dim ofso : Set ofso = Createobject("Scripting.FileSystemObject") Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Call Main() ' --------------------------------------- Sub Main() Dim arrSkater, iCount, iCount2 Dim arrSkaterCalc(), arrTmpSkater Dim arrSkaterEndPoints() Dim iPointsWin, iPoints arrSkater = ReadFileToArray("C:\Scripts\skaters.txt") If IsArray(arrSkater) then ReDim arrSkaterCalc(UBound(arrSkater), 7) ReDim arrSkaterEndPoints(UBound(arrSkater), 1) For iCount = 0 to UBound(arrSkater) If IsArray(arrTmpSkater) then Erase arrTmpSkater arrTmpSkater = Split(arrSkater(iCount), ",", -1, 1) Call SortArray(arrTmpSkater, "ASC") For iCount2 = 0 to UBound(arrTmpSkater) arrSkaterCalc(iCount,iCount2) = arrTmpSkater(iCount2) Next Next For iCount = 0 to UBound(arrSkaterCalc) iPoints = CInt(arrSkaterCalc(iCount,1)) _ + CInt(arrSkaterCalc(iCount,2)) _ + CInt(arrSkaterCalc(iCount,3)) _ + CInt(arrSkaterCalc(iCount,4)) _ + CInt(arrSkaterCalc(iCount,5)) iPointsWin = iPoints / 5 arrSkaterEndPoints(iCount,0) = iPointsWin arrSkaterEndPoints(iCount,1) = arrSkaterCalc(iCount,7) Next Call SortArrayDim2(arrSkaterEndPoints, "DESC") wscript.echo "Gold medal: " & arrSkaterEndPoints(0, 1) & _ ", " & arrSkaterEndPoints(0, 0) wscript.echo "Silver medal: " & arrSkaterEndPoints(1, 1) & _ ", " & arrSkaterEndPoints(1, 0) wscript.echo "Bronze medal: " & arrSkaterEndPoints(2, 1) & _ ", " & arrSkaterEndPoints(2, 0) End if End Sub ' --------------------------------------- Private Function ReadFileToArray(strFile) Dim strNextLine, arrstrList Dim arrLines() Dim iCount : iCount = 0 If ofso.FileExists(strFile) then Dim oFile : Set oFile = ofso.OpenTextFile(strFile, ForReading) Do Until oFile.AtEndOfStream Redim Preserve arrLines(iCount) arrLines(iCount) = oFile.ReadLine iCount = iCount + 1 Loop oFile.Close End if Set oFile = nothing If IsArray(arrLines) then ReadFileToArray = arrLines End Function ' --------------------------------------- Private Function SortArray(SourceArray, strSortTyp) Dim Sorted, iCount, Temp Sorted = False Do While Not Sorted Sorted = True For iCount = 0 To UBound(SourceArray) - 1 Select Case UCase(strSortTyp) Case "ASC" If UCase(SourceArray(iCount)) > UCase(SourceArray(iCount + 1)) Then Temp = SourceArray(iCount + 1) SourceArray(iCount + 1) = SourceArray(iCount) SourceArray(iCount) = Temp Sorted = False End If Case "DESC" If UCase(SourceArray(iCount)) < UCase(SourceArray(iCount + 1)) Then Temp = SourceArray(iCount + 1) SourceArray(iCount + 1) = SourceArray(iCount) SourceArray(iCount) = Temp Sorted = False End If End Select Next Loop End Function ' --------------------------------------- Private Function SortArrayDim2(SourceArray, strSortTyp) Dim Sorted, iCount, Temp, Temp2 Sorted = False Do While Not Sorted Sorted = True For iCount = 0 To UBound(SourceArray) - 1 Select Case UCase(strSortTyp) Case "ASC" If UCase(SourceArray(iCount, 0)) > UCase(SourceArray(iCount + 1, 0)) Then Temp = SourceArray(iCount + 1, 0) Temp2 = SourceArray(iCount + 1, 1) SourceArray(iCount + 1, 0) = SourceArray(iCount, 0) SourceArray(iCount + 1, 1) = SourceArray(iCount, 1) SourceArray(iCount, 0) = Temp SourceArray(iCount, 1) = Temp2 Sorted = False End If Case "DESC" If UCase(SourceArray(iCount, 0)) < UCase(SourceArray(iCount + 1, 0)) Then Temp = SourceArray(iCount + 1, 0) Temp2 = SourceArray(iCount + 1, 1) SourceArray(iCount + 1, 0) = SourceArray(iCount, 0) SourceArray(iCount + 1, 1) = SourceArray(iCount, 1) SourceArray(iCount, 0) = Temp SourceArray(iCount, 1) = Temp2 Sorted = False End If End Select Next Loop End Function | ||
© 2008 - 2013 Boris Toll :: Scripts available: 6.481 :: :: scriptbox.toll.at :: :: powered by www.toll.at :: | ||
